perm filename BLAISE.SAI[TEX,SYS]1 blob sn#526715 filedate 1980-07-28 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	begin "blaise" comment A TEX preprocessor for PASCAL.
C00008 00003	Basic input/output and lookup procedures
C00014 00004	Scanning procedures
C00036 00005	The main program
C00043 ENDMK
C⊗;
begin "blaise" comment A TEX preprocessor for PASCAL.

(See the documentation on file BLAISE.DEK[up,doc].);

require "⊂⊃⊂⊃" delimiters; "used for macros"
define # = ⊂;comment⊃; "used henceforth instead of quoted comments like this"
define nextline = ⊂('15&'12)⊃ # carriage-return and line-feed in print commands;
define thru = ⊂step 1 until⊃ # abbreviation for for clauses;
define DEBUGONLY = ⊂comment⊃ # changed to ⊂⊃ when debugging;
define saf = ⊂safe⊃ # used when an array is believed to require no bounds checks;
DEBUGONLY redefine saf = ⊂⊃ # when debugging, belief turns to disbelief;
DEBUGONLY external procedure bail # the SAIL debugger in case of need;

require 500 system_pdl # this program is highly recursive;
require 500 string_pdl # and gets in trouble without big stacks;
require 25000 string_space;

label final_end # go here when you want to quit;

integer ichan,ochan,brchar,eof,lineno,pageno # standard variables of input system;
string inbuf,curbuf # the input buffers;
string filename,inputfile,outputfile # variables relating to file names;
string saf array fn[0:2] # components of file name;
procedure scanfilename # parses filename, puts parts in the fn array;
begin integer t # (0,1,2) for (name,ext,ppn);
string s # temporary storage;
integer c # current character of string;
s←filename; t←0; fn[0]←fn[1]←fn[2]←"";
while (c←lop(s)) do
	begin if c="." then t←1 else if c="[" then t←2;
	fn[t]←fn[t]&c;
	end;
end;

procedure initio # initialize input and output;
begin while true do
	begin print("Input file: "); filename←inchwl; scanfilename;
	if fn[1]=0 then fn[1]←".PAS";
	inputfile←fn[0]&fn[1]&fn[2];
	open(ichan←getchan,"DSK",0,19,0,200,brchar,eof);
	lookup(ichan,inputfile,eof);
	if not eof then done;
	print("Lookup failed on file ",inputfile,"!",nextline);
	release(ichan);
	end;
while true do
	begin fn[1]←".TEX";
	outputfile←fn[0]&fn[1]&fn[2];
	print("Output file (default = ",outputfile,"): ");
	filename←inchwl;
	if filename then
		begin scanfilename;
		outputfile←fn[0]&fn[1]&fn[2];
		end;
	open(ochan←getchan,"DSK",0,0,19,0,0,eof);
	enter(ochan,outputfile,eof);
	if not eof then done;
	print("Can't write on file ",outputfile,"!",nextline);
	release(ochan);
	filename←inputfile; scanfilename;
	end;
setprint("errors.tmp","B") # output goes to file as well as to user terminal;
setbreak(1,'14,null,"INA") # input(ichan,1) will read up to and including <FF>;
setbreak(2,'12&'14,'15,"INS") # input(ichan,2) will read up to and including
	<LF> or <FF>, discarding <LF>, <FF>, and <CR>;
inbuf←""; pageno←0; brchar←'14;
end;

procedure error(string s) # prints a message to report an anomaly;
begin integer l; l←length(inbuf)-length(curbuf);
print(nextline,"! ",s,".",
nextline,"p.",pageno,",l.",lineno,": ",inbuf[1 to l],""&'12,curbuf);
end;
procedure overflow(string s) # prints error message and aborts;
begin print(nextline,"Capacity exceeded (",s,"), some input is lost.");
go to final_end;
end;
comment Basic input/output and lookup procedures;

boolean identins # if identifier isn't found, insert it;

comment Identifiers are stored in a conventional binary search tree, whose
nodes contain the following fields:
	idname[k], the identifier stored at node k (a string) followed by "}",
	left[k], left son of node k,
	right[k], right son of node k,
	eq[k], the defined equivalent of node k.
The value of eq[k] tells what kind of identifier this is. For example, the
reserved words "begin" and "loop" both have the eq value "t_begin";

define strsize=150 # number of different identifiers allowed;
string saf array idname[1:strsize] # identifier names;
integer saf array left,right,eq[0:strsize] # sons and equivalents;
integer nstrs # number of nodes in the tree;

integer procedure find(string x) # looks for the identifier x;
begin comment This procedure either finds x in the tree, or (if identins is
false) finds the node whose eq field is "ident";
integer k # current node;
integer link # pointer to new node if insertion needs to be done;
string xx # x with a right brace after it;
xx←x&"}";
k←1; link←nstrs+1; idname[link]←xx;
if k<link then while true do
	begin string s,t; integer d;
	if equ(xx,idname[k]) then return(k);
	s←xx; t←idname[k];
	while (d←lop(s)-lop(t))=0 do;
	comment No string will be a prefix of another since they end with "}";
	if d<0 then
		if left[k] then k←left[k]
		else	begin left[k]←link; done;
			end
	else	if right[k] then k←right[k]
		else	begin right[k]←link; done;
			end;
	end;
if identins then
	begin if link≥strsize then overflow("strsize");
	nstrs←link; left[nstrs]←right[nstrs]←0;
	end;
return(link);
end;

define space=1,letter=2,digit=3,doublequote=4,singlequote=5,lpren=6,dot=7,
lbr=8,ident=9,const=10,otherchar=11,star=12,t_up=13,doubledots=14,comma=15,
colon=16,t_comment=17,semi=18,t_close=19,t_string=20,t_program=21,t_var=22,
t_procedure=23,t_begin=24,t_packed=25,t_to=26,t_div=27,t_nil=28,t_record=29,
t_array=30,t_of=31,t_case=32,t_repeat=33,t_until=34,t_then=35,t_if=36,
t_exit=37,t_end=38,underline=39,t_else=40,t_eof=41,t_file=42,t_for=43,t_label=44
	 # arbitrary codes used in the scanner;

preload_with t_eof, [7] otherchar,
	otherchar, [3] space, t_eof, space, [2] otherchar,
	[8] otherchar,
	underline, [7] otherchar,
	space, otherchar, doublequote, [4] otherchar, singlequote,
	lpren, t_close, star, otherchar, comma, otherchar, dot, otherchar,
	[8] digit,
	[2] digit, colon, semi, [4] otherchar,
	t_up, [7] letter,
	[16] letter,
	[3] letter, lbr, otherchar, t_close, t_up, otherchar,
	singlequote, [7] letter,
	[16] letter,
	[3] letter, [5] otherchar;
	saf integer array chartype[0:'177] # types for SUAI ascii;

string curstr # the current translated string;
define cr='15, c5='14, c0='12, c2='13 # characters interpreted by the
	putout procedure;
integer state # if nonzero, this is substituted for the 0 or 2 in \0 or \2;
integer lastout # the last character that was putout (prevents consec cr's);
procedure putout # sends curstr to output, slightly interpreting it;
begin integer c;
while true do
	begin c←lop(curstr);
	if c=0 then done;
	if c="\" and state and (curstr="0" or curstr="2") then
		begin out(ochan,"\"); out(ochan,state); c←lop(curstr); state←0;
		end
	else case c of begin
	[cr] if lastout≠cr then begin out(ochan,nextline); lastout←cr end;
	[c0] state←"0";
	[c2] if state≠"5" then state←"2";
	[c5] state←"5";
	else	begin out(ochan,c); lastout←c
		end
	  end;
	end;
end;
comment Scanning procedures;

integer curtype # type of the token currently being scanned;
string cur5 # either null or c5 (if blank line found by getnext);
string curstr5 # cur5 & curstr;
integer fillcount # increases by 1 when a new line or page is read;
boolean activity # getnext has been called;

procedure fillinbuf # gets the next line of input;
begin if brchar='14 then
	begin pageno←pageno+1; lineno←1; print(" ",pageno);
	fillcount←fillcount+1;
	end
else lineno←lineno+1;
inbuf←input(ichan,2);
if eof and inbuf=0 then inbuf←'14 # the scanner treats '14 as end-of-file;
if pageno=1 and lineno=1 and equ(inbuf[1 to 9],"COMMENT ⊗") then
	begin comment skip TVedit directory page;
	while brchar≠'14 and not eof do inbuf←input(ichan,1);
	inbuf←"";
	end;
curbuf←inbuf;
fillcount←fillcount+1;
end;

procedure getnext # gets the next input token;
begin comment The other procedures for scanning call this one whenever
the current character has been digested and it is time to read a new one.
This procedure is the lexical scanner. It processes identifiers, constants,
comments, "..", and ordinary single characters, setting curtype to the
appropriate code value. It also sets curstr equal to the translation of
the scanned token. Spaces in the input are ignored (except in strings and
comments). Blank lines in the input cause curstr5 to contain a c5 character;
integer c; label restart;
fillcount←-1; activity←true;
restart: while curbuf=0 do fillinbuf;
c←lop(curbuf); curtype←chartype[c];
case curtype of begin
[space] go to restart;
[letter] begin curstr←c; while true do
	begin c←chartype[curbuf];
	if c=letter or c=digit then curstr←curstr&lop(curbuf)
	else if c=underline then
		begin c←lop(curbuf); curstr←curstr&"\_";
		end
	else done;
	end;
curtype←eq[find(curstr)]; if curtype=ident then curstr←"\\{"&curstr&"}" end;
[digit] begin curstr←c; curtype←const; while true do
	begin c←chartype[curbuf];
	if c=digit then curstr←curstr&lop(curbuf)
	else if c=letter then curstr←curstr&"\mathopen{\hbox{"&lop(curbuf)
		&"}}"
	else done;
	end end;
[doublequote] begin curstr←"\.{"&c; curtype←const; # hexadecimal constant;
while true do
	begin c←chartype[curbuf];
	if c=digit or c=letter then curstr←curstr&lop(curbuf)
	else done;
	end;
curstr←curstr&"}"; end;
[singlequote] begin curstr←c; curtype←t_string; while true do
	begin c←lop(curbuf);
	if c='40 then curstr←curstr&"\ "
	else if c then
		begin curstr←curstr&c;
		if c="'" then done;
		end
	else	begin error("String constant didn't end on the line"); done;
		end;
	end end;
[lpren] if curbuf≠"*" then curstr←c else
	begin curstr←"$\{\;$"; curtype←t_comment; c←lop(curbuf);
	while true do
		begin c←lop(curbuf);
		if c="*" and curbuf=")" then
			begin c←lop(curbuf); curstr←curstr&("$\;\}$"&cr&c2);
			done;
			end
		else if c=0 then
			begin fillinbuf; if inbuf then fillcount←fillcount-1;
			curstr←curstr&cr;
			end
		else if c='14 then
			begin error("End of file in middle of comment");
			curbuf←"*)"&'14;
			end
		else curstr←curstr&c;
		end;
	end;
[dot] if curbuf="." then
	begin curtype←doubledots; curstr←"\mathrel{\!.\,.\!}"; c←lop(curbuf);
	end
else curstr←c;
else curstr←c
  end;
if fillcount>0 then cur5←c5 else cur5←""; curstr5←cur5&curstr;
end;

comment The recursive procedures below follow the syntax in BLAISE.SYN
fairly closely;
forward recursive string procedure p_fragment;
forward recursive string procedure p_genexp;
forward recursive string procedure p_outertoken;
forward recursive string procedure p_innertoken;
forward recursive string procedure p_token;
forward recursive string procedure p_speciallist;
forward recursive string procedure p_comments;
forward recursive string procedure p_variant;
forward recursive string procedure p_compoundstatement;
forward recursive string procedure p_statement1;
forward recursive string procedure p_noncompoundstatement;
forward recursive string procedure p_statement;
forward recursive string procedure p_case;

recursive string procedure p_fragment;
begin string str;
case curtype of begin
[t_program] begin str←cur5&"\3\2\&{"&curstr&"} "; getnext;
str←str&p_genexp&"\1" end;
[t_label] begin str←cur5&"\3\2\1\&{"&curstr&"} "; getnext;
while true do
	begin case curtype of begin
	[ident][const] begin str←str&cur5&"\0"&curstr; getnext end;
	[comma] begin str←str&curstr5&"\45\ "; getnext end;
	[t_comment] begin str←str&"\40\ "&curstr5; getnext end;
	else done
	  end
	end end;
[t_var] begin str←cur5&"\3\2\1\&{"&curstr&"} "; getnext;
str←str&p_genexp end;
[t_procedure] begin str←cur5&"\3\2\1\1\&{"&curstr&"} "; getnext;
str←str&p_genexp end;
[t_begin] begin str←cur5&"\3\2"; cur5←""; curstr5←curstr;
str←str&p_compoundstatement end;
else begin str←cur5&c2; cur5←""; curstr5←curstr;
str←str&p_noncompoundstatement end
  end;
return(str);
end;

recursive string procedure p_genexp;
begin string str; integer n;
n←50; str←""; while true do
	begin case curtype of begin
	[lpren][dot][lbr][ident][const][otherchar][star][t_up][doubledots][comma]
	[colon][t_comment][t_string][t_record][t_packed][t_to][t_div][t_nil]
	[t_array][t_file] str←str&p_outertoken;
	else done
	  end;
	if length(str)>n then
		begin comment try to avoid long lines in output;
		str←str&cr; n←n+50;
		end;
	end;
if str then return("$"&str&"$") else return("");
end;

recursive string procedure p_outertoken;
begin string str;
case curtype of begin
[lpren][lbr][t_array][t_file] begin if curtype=t_array then
str←"\mathop{\&{"&curstr5&" }}" else if curtype=t_file then
str←"\mathop{\&{"&curstr5&"}\!}"
else str←curstr5; getnext; while true do
	begin integer n; n←50;
	case curtype of begin
	[lpren][dot][lbr][ident][const][otherchar][star][t_up][doubledots][comma]
	[colon][t_comment][semi][t_string][t_var][t_procedure][t_record][t_packed]
	[t_to][t_div][t_nil][t_array][t_file] str←str&p_innertoken;
	else done
	  end;
	if length(str)>n then
		begin comment try to avoid long lines in output;
		str←str&cr; n←n+50;
		end;
	end;
if curtype = t_close then
 	begin str←str&curstr5; getnext;
	end
else if curtype=t_of then
	begin str←str&"\mathop{\&{\ "&curstr5&" }\!}"; getnext;
	end
else error("Missing a closing symbol") end;
[ident][const][otherchar][star][t_up][t_packed][t_to][t_div][t_nil] str←p_token;
[dot] begin str←curstr5; getnext; str←str&p_token end;
[doubledots] begin str←curstr5; getnext end;
[comma] begin str←curstr5&"\45"; getnext end;
[colon] begin str←"\mathrel"&curstr5; getnext end;
[t_record] begin str←cur5&"\null$\1\2\&{"&curstr&"} "; getnext;
str←str&c0&p_speciallist;
if curtype=t_end then
	begin str←str&cur5&c2&"\2\&{"&curstr&"}$\null\3"; getnext;
	end
else	begin error("Missing end of record type"); str←str&"\3";
	end end;
[t_comment] begin str←"\null$\40 "&curstr5&("$\null"&cr); getnext end;
[t_string] begin str←"\.{"&curstr5&"}"; getnext end;
else error("Bug 1 in BLAISE")
  end;
return(str);
end;

recursive string procedure p_innertoken;
begin string str;
case curtype of begin
[lpren][dot][lbr][ident][const][otherchar][star][t_up][doubledots][comma][colon]
[t_comment][t_string][t_record][t_packed][t_to][t_div][t_nil]
[t_array][t_file] str←p_outertoken;
[semi] begin str←curstr5&"\42\,"; getnext end;
[t_var][t_procedure] begin str←"\mathop{\&{"&curstr5&"}}"; getnext end;
else error("Bug 2 in BLAISE")
  end;
return(str);
end;

recursive string procedure p_token;
begin string str;
case curtype of begin
[ident][const][otherchar] begin str←curstr5; getnext end;
[t_packed] begin str←"\mathop{\&{"&curstr5&" }\!}"; getnext end;
[t_to] begin str←"\mathrel{\&{"&curstr5&"}}"; getnext end;
[t_up] begin str←cur5&"{\up}"; getnext end;
[star] begin str←cur5&"{\ast}"; getnext end;
[t_div] begin str←"\mathbin{\&{"&curstr5&"}}"; getnext end;
[t_nil] begin str←"\&{"&curstr5&"}"; getnext end;
else error("Missing token")
  end;
return(str);
end;

recursive string procedure p_speciallist;
begin string str,str1,str2;
str←""; while true do
	begin str1←cur5; cur5←""; curstr5←curstr;
	str2←p_genexp;
	if str2 then str←str&str1&"\2"&str2 else str←str&str1;
	if curtype≠semi then done;
	str←str&curstr5; getnext;
	str←str&p_comments;
	end;
while curtype=t_case do
	begin str←str&cur5&"\2\1\&{"&curstr&"} "; getnext;
	str←str&p_genexp;
	if curtype=t_of then
		begin str←str&" \&{"&curstr5&"}"; getnext;
		end
	else error("Missing `of'");
	while true do
		begin str←str&p_variant;
		if curtype≠semi then done;
		str←str&curstr5; getnext;
		end;
	str←str&"\3";
	end;
return(str);
end;

recursive string procedure p_comments;
begin string str;
if curtype≠t_comment then return(cr);
str←("\40\"&cr)&curstr5; getnext;
while curtype=t_comment do
	begin str←str&cur5&"\2"&curstr; getnext;
	end;
return(str);
end;

recursive string procedure p_variant;
begin string str;
str←p_comments;
case curtype of begin
[ident][const] ;
[comma] curstr←curstr&"\45";
else return(str)
  end;
str←str&cur5&(cr&"\2\1$")&curstr; getnext;
while true do
	begin case curtype of begin
	[ident][const] ;
	[comma] curstr←curstr&"\45";
	[t_comment] curstr←" $\40\ "&curstr&("$");
	[colon] begin str←str&"\mathrel"&curstr5; getnext; done end;
	else	begin error("Improper token list in variant"); done;
		end
	  end;
	str←str&cur5&curstr; getnext;
	end;
str←str&"\null$"&p_comments;
if curtype=lpren then
	begin str←str&curstr5&c0; getnext;
	end
else error("Missing `(' in variant");
str←str&p_speciallist;
if curtype=t_close then
	begin str←str&curstr5; getnext;
	end
else error("Missing `)' in variant");
str←str&p_comments;
return(str&"\3");
end;

recursive string procedure p_compoundstatement;
begin string str,str1; label recover;
str←"\&{"&curstr5&"} "; getnext;
str←str&p_statement1;
recover: while curtype=semi do
	begin str←str&curstr5; getnext;
	str←str&p_comments&p_statement;
	end;
str←str&p_comments;
if curtype=t_end then
	begin str←str&cur5&(c2&"\2\&{")&curstr&("}"&c2); getnext;
	end
else	begin error("Missing `;'");
	str1←p_statement; if str1 then
		begin str←str&str1; go to recover;
		end;
	error("Missing `end'");
	str←str&(c2&"\2"&c2);
	end;
return(str);
end;

boolean procedure labelpresent # looks ahead to see if colon and no equals is next;
begin integer c,d; label restart;
restart: while chartype[curbuf]=space do c←lop(curbuf);
if curbuf=0 then
	begin fillinbuf; go to restart;
	end;
if chartype[curbuf]=colon then
	begin label restart;
	d←lop(curbuf);
	restart: while chartype[curbuf]=space do c←lop(curbuf);
	if curbuf=0 then
		begin fillinbuf; go to restart;
		end;
	if curbuf≠"=" then return(true) else curbuf←d&curbuf;
	end;
return(false);
end;

recursive string procedure p_statement1;
begin string str,str1;
case curtype of begin
[t_comment] begin str←"\40\ "&curstr5; getnext; while curtype=t_comment do
	begin str←str&cur5&"\2"&curstr; getnext;
	end;
str←str&p_statement end;
[t_begin] str←"\1"&p_compoundstatement&"\3";
[ident][const] if labelpresent then begin str←cur5&"\2"&curstr&": "; getnext;
str←str&p_statement1 end
else str←c0&p_noncompoundstatement;
else str←c0&p_noncompoundstatement
  end;
return(str);
end;

recursive string procedure p_noncompoundstatement;
begin string str; integer tif;
case curtype of begin
[t_exit] begin str←cur5&"\2\&{"&curstr; getnext;
if curtype=t_if then
	begin str←str&" "&curstr5&"} "; getnext;
	end
else	begin error("Missing `if'"); str←str&"}";
	end;
str←str&p_genexp end;
[t_if][t_for] begin tif←curtype; str←cur5&"\2\1\&{"&curstr; getnext;
str←str&"} "&p_genexp;
if curtype=t_then then
	begin str←str&" \&{"&curstr5&"}"; getnext;
	end
else	begin error("Missing `then' or `do'"); str←str&" ";
	end;
str←str&p_comments&p_statement&("\3"&c2)&p_comments;
if tif=t_if and curtype=t_else then
	begin str←str&cur5&"\2\&{"&curstr; getnext;
	str←str&"} "&p_statement1&c2&p_comments;
	end end;
[t_repeat] begin str←cur5&"\2\1\&{"&curstr; getnext;
str←str&"} "&p_statement1;
while curtype=semi do
	begin str←str&curstr5; getnext;
	str←str&p_comments&p_statement;
	end;
str←str&p_comments&cur5&c2&"\3\2\&{";
if curtype=t_until then
	begin str←str&curstr; getnext;
	end
else error("Missing `until'");
str←str&"} "&p_genexp&c2 end;
[t_case] begin str←cur5&"\2\1\&{"&curstr; getnext;
str←str&"} "&p_genexp;
if curtype = t_of then
	begin str←str&" \&{"&curstr5&"}"; getnext;
	end
else error("Missing `of'");
str←str&p_case;
while curtype=semi do
	begin str←str&curstr5; getnext;
	str←str&p_case;
	end;
str←str&p_comments;
if curtype=t_end then
	begin str←str&cur5&c2&"\2\&{"&curstr&("}\3"&c2); getnext;
	end
else	begin error("Missing `end'"); str←str&("\3\2"&c2);
	end end;
else begin str←p_genexp; if str then begin if str[2 for 1]=c5 then
str←(c5&"\0$")& str[3 to ∞] else str←"\0"&str end end
  end;
return(str);
end;

recursive string procedure p_statement;
begin string str;
case curtype of begin
[t_begin] begin str←str&cur5&"\2"; cur5←""; curstr5←curstr;
str←str&p_compoundstatement end;
[ident][const] if labelpresent then begin str←cur5&"\2"&curstr&": ";
getnext; str←str&p_statement1 end
else str←str&p_noncompoundstatement;
else str←str&p_noncompoundstatement
  end;
return(str);
end;

recursive string procedure p_case;
begin string str;
str←p_comments;
case curtype of begin
[ident][const][t_string] begin str←str&cur5&c2&"\2\1";cur5←"";curstr5←curstr;
while true do
	begin case curtype of begin
	[comma] begin str←str&curstr5&"\45\ "; getnext end;
	[t_comment] begin str←str&"\40\ "&curstr5; getnext end;
	[colon] begin str←str&curstr5&" "; getnext; done end;
	[ident][const] str←str&p_token;
	[t_string] begin str←str&curstr; getnext end;
	else begin error("Missing `:'"); done end
	  end;
	end;
str←str&p_statement1&"\3" end;
else comment do nothing;
  end;
return(str);
end;
comment The main program;

nstrs←0; identins←true;
eq[find("label")]←t_var;
eq[find("Label")]←t_var;
eq[find("LABEL")]←t_var;
eq[find("else")]←t_else;
eq[find("Else")]←t_else;
eq[find("ELSE")]←t_else;
eq[find("case")]←t_case;
eq[find("Case")]←t_case;
eq[find("CASE")]←t_case;
eq[find("array")]←t_array;
eq[find("Array")]←t_array;
eq[find("ARRAY")]←t_array;
eq[find("and")]←t_div;
eq[find("And")]←t_div;
eq[find("AND")]←t_div;
eq[find("begin")]←t_begin;
eq[find("Begin")]←t_begin;
eq[find("BEGIN")]←t_begin;
eq[find("div")]←t_div;
eq[find("Div")]←t_div;
eq[find("DIV")]←t_div;
eq[find("const")]←t_var;
eq[find("Const")]←t_var;
eq[find("CONST")]←t_var;
eq[find("do")]←t_then;
eq[find("Do")]←t_then;
eq[find("DO")]←t_then;
eq[find("downto")]←t_to;
eq[find("Downto")]←t_to;
eq[find("DOWNTO")]←t_to;
eq[find("function")]←t_procedure;
eq[find("Function")]←t_procedure;
eq[find("FUNCTION")]←t_procedure;
eq[find("exit")]←t_exit;
eq[find("Exit")]←t_exit;
eq[find("EXIT")]←t_exit;
eq[find("end")]←t_end;
eq[find("End")]←t_end;
eq[find("END")]←t_end;
eq[find("file")]←t_file;
eq[find("File")]←t_file;
eq[find("FILE")]←t_file;
eq[find("for")]←t_for;
eq[find("For")]←t_for;
eq[find("FOR")]←t_for;
eq[find("if")]←t_if;
eq[find("If")]←t_if;
eq[find("IF")]←t_if;
eq[find("goto")]←t_packed;
eq[find("Goto")]←t_packed;
eq[find("GOTO")]←t_packed;
eq[find("in")]←t_to;
eq[find("In")]←t_to;
eq[find("IN")]←t_to;
eq[find("initprocedure")]←t_procedure;
eq[find("Initprocedure")]←t_procedure;
eq[find("INITPROCEDURE")]←t_procedure;
eq[find("record")]←t_record;
eq[find("Record")]←t_record;
eq[find("RECORD")]←t_record;
eq[find("of")]←t_of;
eq[find("Of")]←t_of;
eq[find("OF")]←t_of;
eq[find("mod")]←t_div;
eq[find("Mod")]←t_div;
eq[find("MOD")]←t_div;
eq[find("loop")]←t_begin;
eq[find("Loop")]←t_begin;
eq[find("LOOP")]←t_begin;
eq[find("nil")]←t_nil;
eq[find("Nil")]←t_nil;
eq[find("NIL")]←t_nil;
eq[find("not")]←t_packed;
eq[find("Not")]←t_packed;
eq[find("NOT")]←t_packed;
eq[find("packed")]←t_packed;
eq[find("Packed")]←t_packed;
eq[find("PACKED")]←t_packed;
eq[find("or")]←t_div;
eq[find("Or")]←t_div;
eq[find("OR")]←t_div;
eq[find("procedure")]←t_procedure;
eq[find("Procedure")]←t_procedure;
eq[find("PROCEDURE")]←t_procedure;
eq[find("program")]←t_program;
eq[find("Program")]←t_program;
eq[find("PROGRAM")]←t_program;
eq[find("to")]←t_to;
eq[find("To")]←t_to;
eq[find("TO")]←t_to;
eq[find("segmented")]←t_packed;
eq[find("Segmented")]←t_packed;
eq[find("SEGMENTED")]←t_packed;
eq[find("repeat")]←t_repeat;
eq[find("Repeat")]←t_repeat;
eq[find("REPEAT")]←t_repeat;
eq[find("set")]←t_file;
eq[find("Set")]←t_file;
eq[find("SET")]←t_file;
eq[find("then")]←t_then;
eq[find("Then")]←t_then;
eq[find("THEN")]←t_then;
eq[find("var")]←t_var;
eq[find("Var")]←t_var;
eq[find("VAR")]←t_var;
eq[find("type")]←t_var;
eq[find("Type")]←t_var;
eq[find("TYPE")]←t_var;
eq[find("until")]←t_until;
eq[find("Until")]←t_until;
eq[find("UNTIL")]←t_until;
eq[find("while")]←t_for;
eq[find("While")]←t_for;
eq[find("WHILE")]←t_for;
eq[find("with")]←t_for;
eq[find("With")]←t_for;
eq[find("WITH")]←t_for;

eq[nstrs+1]←ident; identins←false;
comment From now on, all other identifiers will be equivalent to `ident';

initio;
print("(",inputfile);

out(ochan,
"\input basic % Delete this line if you merge BLAISE output with another .TEX file
\input algol % This file defines the necessary macros and font \:t
{\ragged1000000 \jpar10000 \setcount7\Tbb\1 % Beginning BLAISE output:
") # the above info always comes first in the output file;
lastout←cr;
getnext;
while curtype≠t_eof do
	begin activity←false;
	while true do
		begin case curtype of begin
		[dot][semi] curstr←curstr5;
		[t_comment] if cur5 then curstr←c5&"\3\2"&curstr&"\1"
			else curstr←"\40\ "&curstr;
		else done
		  end;
		putout; getnext;
		end;
	curstr←cr&p_fragment; putout;
	if not activity then
		begin error("Uninterpretable fragment"); getnext;
		end;
	end;
print(")");
out(ochan,"
\par} % end of BLAISE output
");
final_end: close(ichan); close(ochan);
end